home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / os2 / ftree11a.zip / CHECK.FTX < prev    next >
Text File  |  1996-10-30  |  12KB  |  377 lines
  1. /*
  2.    Family Tree Rexx Script FTX
  3.  
  4.    Copyright (C) 1996 by <Peter Gervai>
  5.  
  6.    Please send comments to / Kommentar bitte an
  7.    Grin at 2:370/15@fidonet or grin@lifeforce.fido.hu
  8.  
  9.    <
  10.    English:   Check the tree for inconsistencies.             :English
  11.    Deutsch:   Stammbaum nach Inkonsistenzen untersuchen.      :Deutsch
  12.    Nederlands:Check the tree for inconsistencies.             :Nederlands
  13.    Francais:  Vérification de l'arbre pour des incohérences.  :Francais
  14.    >
  15.  
  16.    Long name is <
  17.                  English:    Check Consistency             :English
  18.                  Deutsch:    Prüfe Konsistenz              :Deutsch
  19.                  Nederlands: Check Consistency             :Nederlands
  20.                  Francais:   Vérification des incohérences :Francais
  21.                 >
  22.  
  23. */
  24.  
  25. /*
  26.  * check for:
  27.  *   (self)
  28.  *  born after death
  29.  *  lived longer than usual
  30.  *   (parental)
  31.  *  born sooner than parents
  32.  *  born after parents' death
  33.  *  born sooner than usual (too young mother/father)
  34.  *   (marriages)
  35.  *  married too young
  36.  *  married after death
  37.  *  spouses are male and female
  38.  *  divorced before marriage
  39.  *  divorced after death
  40.  *
  41.  * warnings:
  42.  *   (parental)
  43.  *  changed surname from daddy
  44.  *   (marriages)
  45.  *  had too old partner
  46.  *
  47.  */
  48.  
  49. call InitLanguage
  50.  
  51. say msg.Header.LANG
  52. say '==================='
  53.  
  54.  
  55. /*
  56.  * some initialisations
  57.  */
  58. Warnings = 1                            /* set to 0 if you don't want warnings */
  59. if \Warnings then
  60.   say '(Warnings are suppressed)'
  61.  
  62. oldestManEver    = 150*365
  63. youngestPregnant =  16*365
  64. youngestMarried  =  14*365              /* ...not counting India... :) */
  65.  
  66. oldestMarried    =  60*365
  67.  
  68. humanPregnancy   =   9*31
  69.  
  70. res = SelectPerson('F')
  71.  
  72. do while res\=0
  73.  
  74.   call FetchPerson 1
  75.  
  76.   /*
  77.    * personal checks
  78.    */
  79.   /*-- there is no "missing data" warnings this time. anyone needs it? */
  80.   if p.1.birthc & p.1.deathc then do
  81.     if p.1.birth1 > p.1.death1 then
  82.       call perror msg.BornAfterDeath.LANG,p.1.birth'/'p.1.death
  83.     else do
  84.       if p.1.death1-p.1.birth1 > oldestManEver then
  85.         call perror msg.BornBeforeParent.LANG,(p.1.death1-p.1.birth1)/365 || msg.Years.LANG
  86.     end
  87.   end
  88.  
  89.   /* ...except this one :) */
  90.   if p.1.sex=0 then
  91.     call pwarning msg.NoGender.LANG,'0'
  92.  
  93.   /*
  94.    * checking of parents
  95.    */
  96.   res=doStack('PP')                     /* push actual guy */
  97.   res=SelectFamily('p')                 /* get his parents */
  98.   if res\=0 then do
  99.     res=SelectPerson('p')               /* get parent1 */
  100.     call FetchPerson 2
  101.     res=SelectPerson('p')               /* get parent2 */
  102.     call FetchPerson 3
  103.  
  104.     if p.1.birthc then do
  105.  
  106.     /* check older than parent / young parent */
  107.       if p.2.birthc then do
  108.         if p.1.birth1<=p.2.birth1 then
  109.           call perror msg.BornBeforeParent.LANG,p.1.birth'/'p.2.birth '['p.2.sname p.2.fname']'
  110.  
  111.         if p.1.birth1-p.2.birth1 < youngestPregnant then
  112.           call perror msg.TooYoungParent.LANG,(p.1.birth1-p.2.birth1)/365 msg.Years.LANG'['p.2.sname p.2.fname']'
  113.       end
  114.  
  115.       if p.3.birthc then do
  116.         if p.1.birth1<=p.3.birth1 then
  117.           call perror msg.BornBeforeParent.LANG,p.1.birth'/'p.3.birth '['p.3.sname p.3.fname']'
  118.  
  119.         if p.1.birth1-p.3.birth1 < youngestPregnant then
  120.           call perror msg.TooYoungParent.LANG,(p.1.birth1-p.3.birth1)/365 msg.Years.LANG'['p.3.sname p.3.fname']'
  121.       end
  122.  
  123.       /* check dead&pregnant parent */
  124.       if p.2.deathc then do
  125.         if p.1.birth1-humanPregnancy>=p.2.death1 then
  126.           call perror msg.ParentDiedBefore.LANG,p.1.birth'/'p.2.death '['p.2.sname p.2.fname']'
  127.       end
  128.  
  129.       if p.3.deathc then do
  130.         if p.1.birth1-humanPregnancy>=p.3.death1 then
  131.           call perror msg.ParentDiedBefore.LANG,p.1.birth'/'p.3.death '['p.3.sname p.3.fname']'
  132.       end
  133.  
  134.     end /* p.1.birth=\'' */
  135.  
  136.     /* check that surname is the same as daddy's */
  137.     if p.2.sex=1 then do
  138.       if p.1.sname\='' & p.2.sname\='' & p.1.sname\=p.2.sname then
  139.         call pwarning msg.SurnameChanged.LANG,p.1.sname'/'p.2.sname
  140.     end
  141.     else do
  142.       if p.3.sex=1 then do
  143.         if p.1.sname\='' & p.3.sname\='' & p.1.sname\=p.3.sname then
  144.           call pwarning msg.SurnameChanged.LANG,p.1.sname'/'p.3.sname
  145.       end
  146.     end
  147.  
  148.  
  149.   end /* if have family */
  150.  
  151.   /*
  152.    * Checking marriages
  153.    */
  154.   res=doStack('pP')                     /* get back actual guy */
  155.  
  156.   famNum = 1
  157.   res=SelectFamily(famNum)
  158.  
  159.   do while res\=0
  160.     call FetchFamily famNum
  161.  
  162.     if f.famNum.marry\='' then do
  163.     /* married too young */
  164.       if p.1.birthc then
  165.         if f.famNum.marry1-p.1.birth1<youngestMarried then
  166.           call perror msg.MarriedTooYoung.LANG,(f.famNum.marry1-p.1.birth1)/365 msg.Years.LANG '['msg.Family.LANG famNum']'
  167.  
  168.       /* married after death */
  169.       if p.1.deathc then
  170.         if f.famNum.marry1>p.1.death1 then
  171.           call perror msg.MarriedADeath.LANG,p.1.death'/'f.famNum.marry '['msg.Family.LANG famNum']'
  172.     end
  173.  
  174.     if f.famNum.divor\='' then do
  175.     /* divorced before marriage (even I think it's a good idea :)) */
  176.       if f.famNum.marry\='' then
  177.         if f.famNum.divor1<=f.famNum.marry1 then
  178.           call perror msg.DivorceBMarriage.LANG,f.famNum.divor'/'f.famNum.marry '['msg.Family.LANG famNum']'
  179.  
  180.       /* divorced after death */
  181.       if p.1.deathc then
  182.         if f.famNum.divor1>p.1.death1 then
  183.           call perror msg.DivorceADeath.LANG,f.famNum.divor'/'p.1.death '['msg.Family.LANG famNum']'
  184.     end
  185.  
  186.     /* married to the same sex [Dutch users should comment this out :-))) ] */
  187.     res=doStack('PP')
  188.     res=SelectPerson('p')
  189.     call FetchPerson 4
  190.     if p.1.sex\=0 then
  191.       if p.1.sex = p.4.sex then
  192.         call perror msg.MarriedSSex.LANG,p.1.sex'/'p.4.sex '['p.4.sname p.4.fname']'
  193.  
  194.     /* too old partner ("masochist check") */
  195.     if p.1.birthc & p.4.birthc then
  196.       if abs(p.1.birth1-p.4.birth1)>oldestMarried then
  197.         call pwarning msg.OldPartner.LANG,abs(p.1.birth1-p.4.birth1)/365 msg.Years.LANG '['p.4.sname p.4.fname']'
  198.  
  199.     res=doStack('pP')
  200.  
  201.     famNum = famNum + 1
  202.     res=SelectFamily(famNum)
  203. end /* do */
  204.  
  205.  
  206. /* finished */
  207.  
  208.   res = SelectPerson('N')
  209. end
  210.  
  211. return
  212.  
  213.  
  214. /******************************************************************
  215.  *
  216.  * Fetch personal data
  217.  *
  218.  */
  219. FetchPerson: parse arg n
  220.  
  221.   p.n.id    = GetPID()
  222.   p.n.sname = GetName()
  223.   first=pos(",",p.n.sname)                /* Maybe there's a comma separated title */
  224.   if first>0 then p.n.sname=substr(p.n.sname,1,first-1)
  225.   p.n.fname = GetFirstName()
  226.   p.n.sex   = GetSex()                    /* or "got sex?" :) */
  227.   p.n.birth = GetBirthDate()              /* I can't tell him to tell the format *I* like */
  228.   p.n.birth1= GetBirthDate('d')           /* days since 0 */
  229.   p.n.birthc= GetBirthDate('c')           /* complete date ? */
  230.   p.n.bplace= GetBirthPlace()
  231.   p.n.death = GetDeathDate()
  232.   p.n.death1= GetDeathDate('d')
  233.   p.n.deathc= GetDeathDate('c')           /* complete date ? */
  234.   p.n.dplace= GetDeathPlace()
  235.   p.n.occup = GetOccupation()
  236.   p.n.memo  = GetMemo()
  237.   p.n.pic   = GetPicture()
  238. return
  239.  
  240. /******************************************************************
  241.  *
  242.  * Fetch family data
  243.  *
  244.  */
  245. FetchFamily: parse arg n
  246.  
  247.   f.n.id    = GetFID()
  248.   f.n.marry = GetMarriageDate()
  249.   f.n.marry1= GetMarriageDate('d')
  250.   f.n.mplace= GetMarriagePlace()
  251.   f.n.divor = GetDivorceDate()
  252.   f.n.divor1= GetDivorceDate('d')
  253. return
  254.  
  255. /******************************************************************
  256.  *
  257.  * Errors and warnings
  258.  *
  259.  */
  260. perror:
  261.   say msg.Error.LANG'! ID='p.1.id '"'p.1.fname','p.1.sname'":' arg(1) '('arg(2)')'
  262. return
  263.  
  264. pwarning:
  265.   if \Warnings then return
  266.   say msg.Warning.LANG' ID='p.1.id '"'p.1.fname','p.1.sname'":' arg(1) '('arg(2)')'
  267. return
  268.  
  269.  
  270. /******************************************************************
  271.  *
  272.  * Language init
  273.  *
  274.  */
  275. InitLanguage:
  276.  
  277.    /* Calculate Language Index */
  278.    lang='E'                              /* Default -> [E]nglish */
  279.    IF getLanguage()='Deutsch' THEN       /* Deutsch -> [G]erman */
  280.       lang='G'
  281.    IF getLanguage()='Nederlands' THEN    /* Nederlands -> [D]utch */
  282.       lang='D'
  283.    IF getLanguage()='Francais' THEN      /* Francais -> [F]rench */
  284.       lang='F'
  285.  
  286.    /* [E]nglish Messages */
  287.    msg.Header.E  = 'Checking Family Tree for inconsistencies.'
  288.    msg.Error.E   = 'Error'
  289.    msg.Warning.E = 'Warning at'
  290.    msg.Years.E   = ' years'                          /* "999 years old" */
  291.    msg.Family.E  = 'Family'                          /* "Family 2" */
  292.  
  293.    msg.BornAfterDeath.E  = 'Born after death'
  294.    msg.BornBeforeParent.E = 'Born before parent'
  295.    msg.ParentDiedBefore.E = 'Parent died before child born'
  296.    msg.MarriedTooYoung.E  = 'Married too young'
  297.  
  298.    msg.MarriedADeath.E    = 'Married after death'
  299.    msg.MarriedSSex.E      = 'Married to the same sex'
  300.    msg.DivorceBMarriage.E = 'Divorced before marriage'
  301.    msg.DivorceADeath.E    = 'Divorced after death'
  302.    msg.TooYoungParent.E   = 'Have too young parent'
  303.  
  304.    msg.SurnameChanged.E   = "Surname changed from father's"
  305.    msg.NoGender.E         = 'Person have no gender'
  306.    msg.OldPartner.E       = 'Have quite old partner'
  307.  
  308.    /* [G]erman Messages */
  309.    msg.Header.G  = 'Untersuche Stammbaum nach Inkonsistenzen.'
  310.    msg.Error.G   = 'Fehler'
  311.    msg.Warning.G = 'Warnung bei'
  312.    msg.Years.G   = ' Jahre'                            /* "999 years old" */
  313.    msg.Family.G  = 'Familie'                           /* "Family 2" */
  314.  
  315.    msg.BornAfterDeath.G  = 'Geburt nach Tod'
  316.    msg.BornBeforeParent.G = 'Geboren vor Elternteil'
  317.    msg.ParentDiedBefore.G = 'Elternteil gestorben befor Kind geboren'
  318.    msg.MarriedTooYoung.G  = 'Zu jung verheiratet'
  319.  
  320.    msg.MarriedADeath.G    = 'Heirat nach Tod'
  321.    msg.MarriedSSex.G      = 'Heirated  mit gleichem Geschlecht'
  322.    msg.DivorceBMarriage.G = 'Scheidung vor Heirat'
  323.    msg.DivorceADeath.G    = 'Scheidung nach Tod'
  324.    msg.TooYoungParent.G   = 'Zu junge Eltern'
  325.  
  326.    msg.SurnameChanged.G   = 'Nicht der Nachname des Vaters'
  327.    msg.NoGender.G         = 'Person ohne Geschlecht'
  328.    msg.OldPartner.G       = 'Ziemlich alter Partner'
  329.  
  330.  
  331.    /* [D]utch Messages */
  332.    msg.Header.D  = 'Checking Family Tree for inconsistencies.'
  333.    msg.Error.D   = 'Error'
  334.    msg.Warning.D = 'Warning at'
  335.    msg.Years.D   = ' years'                          /* "999 years old" */
  336.    msg.Family.D  = 'Family'                          /* "Family 2" */
  337.  
  338.    msg.BornAfterDeath.D  = 'Born after death'
  339.    msg.BornBeforeParent.D = 'Born before parent'
  340.    msg.ParentDiedBefore.D = 'Parent died before child born'
  341.    msg.MarriedTooYoung.D  = 'Married too young'
  342.  
  343.    msg.MarriedADeath.D    = 'Married after death'
  344.    msg.MarriedSSex.D      = 'Married to the same sex'
  345.    msg.DivorceBMarriage.D = 'Divorced before marriage'
  346.    msg.DivorceADeath.D    = 'Divorced after death'
  347.    msg.TooYoungParent.D   = 'Have too young parent'
  348.  
  349.    msg.SurnameChanged.D   = "Surname changed from father's"
  350.    msg.NoGender.D         = 'Person have no gender'
  351.    msg.OldPartner.D       = 'Have quite old partner'
  352.  
  353.    /* [F]rench Messages */
  354.    msg.Header.F  = "Vérification de l'arbre généalogique pour des incohérences."
  355.    msg.Error.F   = "Erreur"
  356.    msg.Warning.F = "Problème à"
  357.    msg.Years.F   = " années"                          /* "999 years old" */
  358.    msg.Family.F  = "Famille"                          /* "Family 2" */
  359.  
  360.    msg.BornAfterDeath.F   = "Né(e) aprés le décès"
  361.    msg.BornBeforeParent.F = "Né(e) avant le parent"
  362.    msg.ParentDiedBefore.F = "Parent décédé(e) avant que l'enfant ne naisse"
  363.    msg.MarriedTooYoung.F  = "Marié(e) trop jeune"
  364.  
  365.    msg.MarriedADeath.F    = "Marié(e) aprés le décès"
  366.    msg.MarriedSSex.F      = "Marié(e) à quelqu'un du même sexe"
  367.    msg.DivorceBMarriage.F = "Divorcé(e) avant le mariage"
  368.    msg.DivorceADeath.F    = "Divorcé(e) aprés le décès"
  369.    msg.TooYoungParent.F   = "A un parent trop jeune"
  370.  
  371.    msg.SurnameChanged.F   = "Nom différent de celui du père"
  372.    msg.NoGender.F         = "Le sexe de cette personne n'est pas défini"
  373.    msg.OldPartner.F       = "A un conjoint vraiment agé"
  374.  
  375.    /* Done */ 
  376.    return
  377.